home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / random / Ezdslrnd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-03-18  |  9.8 KB  |  397 lines
  1. {===EZDSLRND==========================================================
  2.  
  3. Part of the Delphi Structures Library--the random number generator
  4.  
  5. EZDSLRND is Copyright (c) 1995-1998 by Julian M. Bucknall
  6.  
  7. VERSION HISTORY
  8. 18Mar98 JMB 3.00 Initial release (BETA TEST)
  9. ======================================================================}
  10. { Copyright (c) 1993-1998, Julian M. Bucknall. All Rights Reserved   }
  11.  
  12. unit EZDSLRnd;
  13.  
  14. {$I EZDSLDEF.INC}
  15. {---Place any compiler options you require here-----------------------}
  16.  
  17.  
  18. {---------------------------------------------------------------------}
  19. {$I EZDSLOPT.INC}
  20.  
  21. interface
  22.  
  23. uses
  24.   {$IFDEF Win32}
  25.   EZDSLThd,
  26.   {$ENDIF}
  27.   SysUtils;
  28.  
  29. type
  30.   DWORD = longint;
  31.  
  32. type
  33.   TEZRandomGenerator = class
  34.     private
  35.       rgList : pointer;
  36.       {$IFDEF Win32}
  37.       rgResLock   : TezResourceLock;
  38.       {$ENDIF}
  39.     protected
  40.     public
  41.       constructor Create;
  42.         {-Create the generator}
  43.       destructor Destroy; override;
  44.         {-Destroy the generator}
  45.  
  46.       procedure AcquireAccess;
  47.         {-Lock the generator in a multithreaded process}
  48.       procedure ReleaseAccess;
  49.         {-Unlock the generator in a multithreaded process}
  50.  
  51.       procedure SetSeed(const aSeed : longint);
  52.         {-Reseed the generator, if aSeed is zero the generator reseeds
  53.           from the system clock}
  54.  
  55.       function Random : double;
  56.         {-Return a random number in the range: 0.0 <= R < 1.0}
  57.       function RandomByte : byte;
  58.         {-Return a random byte in the range: 0 <= R < 256}
  59.       function RandomWord : word;
  60.         {-Return a random word in the range: 0 <= R < 65536}
  61.       function RandomLong : longint;
  62.         {-Return a random longint in the range: 0 <= R < 2,147,483,648}
  63.       function RandomDWord : DWORD;
  64.         {-Return a random dword in the range: 0 <= R < 4,294,967,296}
  65.  
  66.       function RandomIntLimit(aUpperLimit : integer) : integer;
  67.         {-Return a random integer in the range: 0 <= R < aUpperLimit}
  68.         { NOTE: no check is made to see whether aUpperLimit > 0}
  69.       function RandomIntRange(aLowerLimit, aUpperLimit : integer) : integer;
  70.         {-Return a random integer in the range: aLowerLimit <= R < aUpperLimit}
  71.         { NOTE: no check is made to see whether aUpperLimit > aLowerLimit}
  72.  
  73.       function RandomFloatLimit(aUpperLimit : double) : double;
  74.         {-Return a random double in the range: 0.0 <= R < aUpperLimit}
  75.         { NOTE: no check is made to see whether aUpperLimit > 0}
  76.       function RandomFloatRange(aLowerLimit, aUpperLimit : double) : double;
  77.         {-Return a random double in the range: aLowerLimit <= R < aUpperLimit}
  78.         { NOTE: no check is made to see whether aUpperLimit > aLowerLimit}
  79.   end;
  80.  
  81. implementation
  82.  
  83. {References:
  84.   Random bit generator from Numerical Recipes in Pascal
  85.   Additive random number generator from Knuth: Seminumerical
  86.      Algorithms
  87.  Random sequence validation:
  88.   Output from TEZRandomGenerator has been validated with the DIEHARD
  89.   suite, please see http://stat.fsu.edu/~geo/diehard.html for details}
  90.  
  91. uses
  92.   {$IFDEF Win32}
  93.   Windows; {for GetTickCount}
  94.   {$ENDIF}
  95.   {$IFDEF Windows}
  96.   WinTypes, WinProcs; {for DOS3Call}
  97.   {$ENDIF}
  98.  
  99. const
  100.   {Values are selected from Knuth 3.2.2}
  101.   TableMagic   = 24;
  102.   TableEntries = 55;
  103.  
  104. const
  105.   Scale : integer = -31;
  106.  
  107. type
  108.   PrgTable = ^TrgTable;
  109.   TrgTable = packed record
  110.     tFrmOfs : integer;
  111.     tToOfs  : integer;
  112.     tEntries: array [0..pred(TableEntries)] of longint;
  113.   end;
  114.  
  115. {===Helper routines==================================================}
  116. function Random32Bit(aSeed : longint) : longint;
  117. {$IFDEF Win32}
  118. {Input:  EAX = current seed
  119.  Output: EAX = 32-bit random value & new seed}
  120. register;
  121. asm
  122.   push ebx
  123.   mov ebx, eax
  124.   mov ecx, 32         {use ecx as the count}
  125. @@NextBit:
  126.   mov edx, ebx
  127.   mov eax, ebx
  128.   shr edx, 1          {xor with bit 1 of seed}
  129.   xor eax, edx
  130.   shr edx, 1          {xor with bit 2 of seed}
  131.   xor eax, edx
  132.   shr edx, 2          {xor with bit 4 of seed}
  133.   xor eax, edx
  134.   shr edx, 2          {xor with bit 6 of seed}
  135.   xor eax, edx
  136.   shr edx, 25         {xor with bit 31 of seed}
  137.   xor eax, edx
  138.   and eax, 1          {isolate the new random bit}
  139.   shl ebx, 1          {shift seed left by one}
  140.   or ebx, eax         {add in the new bit to the seed as bit 0}
  141.   dec ecx             {go get next random bit, until we've got them all}
  142.   jnz @@NextBit
  143.   mov eax, ebx        {return random bits}
  144.   pop ebx
  145. end;
  146. {$ENDIF}
  147. {$IFDEF Windows}
  148. near; assembler;
  149. asm
  150.   mov dx, aSeed.Word[2]
  151.   mov bx, aSeed.Word[0]
  152.   mov cx, 32          {use cx as the count}
  153. @@NextBit:
  154.   mov si, bx
  155.   mov ax, si          {get bit 0 of seed}
  156.   shr si, 1           {xor with bit 1 of seed}
  157.   xor ax, si
  158.   shr si, 1           {xor with bit 2 of seed}
  159.   xor ax, si
  160.   shr si, 1           {xor with bit 4 of seed}
  161.   shr si, 1
  162.   xor ax, si
  163.   shr si, 1           {xor with bit 6 of seed}
  164.   shr si, 1
  165.   xor ax, si
  166.   mov si, dx          {xor with bit 31 of seed}
  167.   shl si, 1
  168.   rcl si, 1
  169.   xor ax, si
  170.   and ax, 1           {isolate the new random bit}
  171.   shl bx, 1           {shift seed left by one}
  172.   rcl dx, 1
  173.   or bx, ax           {add in the new bit to the seed as bit 0}
  174.   loop @@NextBit      {go get next random bit, until we've got them all}
  175.   mov ax, bx          {return new seed}
  176. end;
  177. {$ENDIF}
  178. {--------}
  179. procedure InitTable(aTable : PrgTable; aSeed : longint);
  180. var
  181.   i : integer;
  182. begin
  183.   with aTable^ do begin
  184.     tToOfs := pred(TableEntries);
  185.     tFrmOfs := pred(TableMagic);
  186.     for i := 0 to pred(TableEntries) do begin
  187.       aSeed := Random32bit(aSeed);
  188.       tEntries[i] := aSeed;
  189.     end;
  190.   end;
  191. end;
  192. {--------}
  193. function GetNextRandomDWORD(aTable : PrgTable) : DWORD;
  194. type
  195.   DWArray = array [0..1] of word;
  196. var
  197.   i   : integer;
  198.   ResultAsWords : DWArray absolute Result;
  199. begin
  200.   with aTable^ do begin
  201.     for i := 0 to 1 do begin
  202.       inc(tEntries[tToOfs], tEntries[tFrmOfs]);
  203.       ResultAsWords[i] := DWArray(tEntries[tToOfs])[1];
  204.       if (tToOfs = 0) then begin
  205.         tToOfs := pred(TableEntries);
  206.         dec(tFrmOfs);
  207.       end
  208.       else begin
  209.         dec(tToOfs);
  210.         if (tFrmOfs = 0) then
  211.           tFrmOfs := pred(TableEntries)
  212.         else
  213.           dec(tFrmOfs);
  214.       end;
  215.     end;
  216.   end;
  217. end;
  218. {--------}
  219. (****
  220. function GetNextRandomWord(aTable : PrgTable) : Word;
  221. begin
  222.   with aTable^ do begin
  223.     inc(tEntries[tToOfs], tEntries[tFrmOfs]);
  224.     Result := word(tEntries[tToOfs]);
  225.     if (tToOfs = 0) then begin
  226.       tToOfs := pred(TableEntries);
  227.       dec(tFrmOfs);
  228.     end
  229.     else begin
  230.       dec(tToOfs);
  231.       if (tFrmOfs = 0) then
  232.         tFrmOfs := pred(TableEntries)
  233.       else
  234.         dec(tFrmOfs);
  235.     end;
  236.   end;
  237. end;
  238. ****)
  239. {====================================================================}
  240.  
  241.  
  242. {===TEZRandomGenerator===============================================}
  243. constructor TEZRandomGenerator.Create;
  244. begin
  245.   inherited Create;
  246.   GetMem(rgList, sizeof(TrgTable));
  247.   SetSeed(0);
  248.   {$IFDEF Win32}
  249.   rgResLock := TezResourceLock.Create;
  250.   {$ENDIF}
  251. end;
  252. {--------}
  253. destructor TEZRandomGenerator.Destroy;
  254. begin
  255.   if (rgList <> nil) then
  256.     FreeMem(rgList, sizeof(TrgTable));
  257.   {$IFDEF Win32}
  258.   rgResLock.Free;
  259.   {$ENDIF}
  260.   inherited Destroy;
  261. end;
  262. {--------}
  263. procedure TEZRandomGenerator.AcquireAccess;
  264. begin
  265.   {$IFDEF Win32}
  266.   rgResLock.Lock;
  267.   {$ENDIF}
  268. end;
  269. {--------}
  270. procedure TEZRandomGenerator.ReleaseAccess;
  271. begin
  272.   {$IFDEF Win32}
  273.   rgResLock.Unlock;
  274.   {$ENDIF}
  275. end;
  276. {--------}
  277. function TEZRandomGenerator.Random : double;
  278. {$IFDEF Win32}
  279. register;
  280. asm
  281.   call RandomDword
  282.   shr eax, 1
  283.   push eax
  284.   fild Scale
  285.   fild dword ptr [esp]
  286.   fscale
  287.   fstp st(1)
  288.   pop eax
  289. end;
  290. {$ENDIF}
  291. {$IFDEF Windows}
  292. assembler;
  293. var
  294.   R : longint;
  295.   Scale : integer;
  296. asm
  297.   les di, Self
  298.   push di
  299.   push es
  300.   call RandomDword
  301.   shr dx, 1
  302.   rcr ax, 1
  303.   mov R.Word[0], ax
  304.   mov R.Word[2], dx
  305.   mov Scale, -31
  306.   fild Scale
  307.   fild R
  308.   fscale
  309.   fstp st(1)
  310.   fwait
  311. end;
  312. {$ENDIF}
  313. {--------}
  314. function TEZRandomGenerator.RandomByte : byte;
  315. begin
  316.   Result := byte(GetNextRandomDWORD(PrgTable(rgList)));
  317. end;
  318. {--------}
  319. function TEZRandomGenerator.RandomDWord : DWORD;
  320. begin
  321.   Result := GetNextRandomDWORD(PrgTable(rgList));
  322. end;
  323. {--------}
  324. function TEZRandomGenerator.RandomFloatLimit(aUpperLimit : double) : double;
  325. begin
  326.   Result := Random * aUpperLimit;
  327. end;
  328. {--------}
  329. function TEZRandomGenerator.RandomFloatRange(aLowerLimit, aUpperLimit : double) : double;
  330. begin
  331.   Result := (Random * (aUpperLimit - aLowerLimit)) + aLowerLimit;
  332. end;
  333. {--------}
  334. function TEZRandomGenerator.RandomIntLimit(aUpperLimit : integer) : integer;
  335. {$IFDEF Win32}
  336. register;
  337. asm
  338.   push edx
  339.   call RandomDWord
  340.   pop edx
  341.   mul edx
  342.   mov eax, edx
  343. end;
  344. {$ENDIF}
  345. {$IFDEF Windows}
  346. assembler;
  347. asm
  348.   les di, Self
  349.   push di
  350.   push es
  351.   call RandomDword
  352.   mov ax, dx
  353.   mul aUpperLimit
  354.   mov ax, dx
  355. end;
  356. {$ENDIF}
  357. {--------}
  358. function TEZRandomGenerator.RandomIntRange(aLowerLimit, aUpperLimit : integer) : integer;
  359. begin
  360.   Result := RandomIntLimit(aUpperLimit - aLowerLimit) + aLowerLimit;
  361. end;
  362. {--------}
  363. function TEZRandomGenerator.RandomLong : longint;
  364. begin
  365.   Result := GetNextRandomDWORD(PrgTable(rgList)) shr 1;
  366. end;
  367. {--------}
  368. function TEZRandomGenerator.RandomWord : word;
  369. begin
  370.   Result := word(GetNextRandomDWORD(PrgTable(rgList)));
  371. end;
  372. {--------}
  373. procedure TEZRandomGenerator.SetSeed(const aSeed : longint);
  374. var
  375.   SeedValue : longint;
  376. begin
  377.   if (aSeed <> 0) then
  378.     SeedValue := aSeed
  379.   else begin
  380.     {$IFDEF Win32}
  381.     SeedValue := GetTickCount;
  382.     {$ELSE}
  383.     asm
  384.       mov ah, $2C
  385.       call DOS3Call
  386.       mov SeedValue.Word[0], cx
  387.       mov SeedValue.Word[2], dx
  388.     end;
  389.     {$ENDIF}
  390.   end;
  391.   InitTable(PrgTable(rgList), SeedValue);
  392. end;
  393. {====================================================================}
  394.  
  395. end.
  396.  
  397.